home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
MENU_UTL
/
PULL32TP
/
PULLTEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-10-21
|
28KB
|
564 lines
Program PullTest;
uses Crt, Dos, Pulldwn1;
label menu2;
(* ------------------------------------------------------------------------ *)
(* *)
(* This source and PULLDWN1.TPU may be used freely in your programs. *)
(* *)
(* Copywrite 1987 David Sampson *)
(* P.O. Box 060573 *)
(* Palm Bay, FL 32906 *)
(* *)
(* The enhanced version with Source is available for $25 (overseas *)
(* customers please add $3 for shipping. *)
(* ------------------------------------------------------------------------ *)
(* ------------------------------------------------------------------------ *)
(* Start of Pulldown Declarations Contained in Pulldown Unit *)
(* ------------------------------------------------------------------------ *)
(* defines a data structure that holds the entire contents for each submenu *)
{type}
(* ------------------------- SubMenu Declarations ----------------------- *)
(* Num_Submenu_Entries - is the number of things in the submenu *)
(* SubmenuChar - is the Captialized first letter in the submenu string. *)
(* Make the first letter unique so that pressing it (upper or *)
(* lower case) makes the submenu selection. You could also *)
(* substitute numbers. *)
(* SubmenuString - is the rest of the string that will be displayed in each *)
(* submenu position. *)
(* ------------------------------------------------------------------------ *)
{
Num_Pop_Up_Menu_Entries = 1..10;
SubMenuPtr = ^SubMenu_Record;
SubMenu_Record = record
Num_Submenu_Entries : Integer;
Submenu_Width : Integer;
SubmenuChar : Array [1..10] of char;
SubmenuString : Array [1..10] of string;
end;
MenuPtr = ^MenuItemsM;
MenuItemsM = Record
MenuEntriesFirst : Array [Num_Pop_Up_Menu_Entries] of char;
MenuEntriesString : Array [Num_Pop_Up_Menu_Entries] of string;
end;
string80 = string[80]; }
(* define the main pulldown menu header line, contents and positions *)
{
var
NumofHeaders : Integer;
Pulldown_Menu_Number : Integer;
Pulldown_Menu_Selection : Integer;
PopUp_Menu_Selection : Integer;
Show_Sub : Boolean;
Selection_Made : Boolean;
Done : Boolean;
FirstChar : Array [1..10] of Char;
HeadLine : Array [1..10] of String;
HeadSpot : Array [1..10] of Integer;
SubMenu : Array [1..10] of SubmenuPtr;
Menu_Items : Array [1..10] of MenuPtr;
ch : Char;
Pulldown_Title_Justify : Char;
Main_Title : String80;
Procedure Cursor_On;
Procedure Cursor_Off;
Procedure DrawMainHeader;
Procedure HandleKeyMain (ch : Char);
Procedure HandleFuncKeyMain (ch : Char);
Procedure Save_Screen;
Procedure Restore_Screen;
Procedure MakeMenu (x1_M, y1_M, x2_M, y2_M : Integer;
Menu_ItemsM : MenuPtr);
}
(* ------------------------------------------------------------------------ *)
(* End of Pulldown Declarations contained in Pulldown Unit *)
(* ------------------------------------------------------------------------ *)
Var Done_PopUp_Menu : Boolean;
(* --------------------------- Your Variables ----------------------------- *)
{ put your variables here }
(* ------------------------------------------------------------------------ *)
Procedure MainMenu_Init;
begin
NumofHeaders := 4; { number of headers in pulldown menu }
FirstChar[1] := 'E'; { first char that will be highlighted }
FirstChar[2] := 'D'; { use char or numbers, but make them unique }
FirstChar[3] := 'G';
FirstChar[4] := 'P';
HeadLine[1] := 'dit'; { rest of pulldown string }
Headline[2] := 'isk';
HeadLine[3] := 'raph';
HeadLine[4] := 'ortfolio';
HeadSpot[1] := 10; { starting col for pulldown headers }
HeadSpot[2] := 25;
HeadSpot[3] := 42;
HeadSpot[4] := 58;
Main_Title := 'Program Title'; {set to '' if you do not want title}
Pulldown_Title_Justify := 'c'; { L, R & C are valid }
end;
(* --------------------- Pulldown Sub Menu Definitions ------------------- *)
Procedure Submenu_Init;
begin
(* ------------------------------------------------------------------------- *)
(* Contents of Sub Menu # 1 *)
(* ------------------------------------------------------------------------- *)
new (SubMenu[1]); {creates variable on the heap}
with Submenu[1]^ do
begin
Num_Submenu_Entries := 3;
Submenu_Width := 8;
SubMenuChar[1] := '1'; { first char or num will }
SubmenuChar[2] := '2'; { be highlighted }
SubmenuChar[3] := '3';
SubMenuString[1] := ' Item 1'; { rest of string }
SubmenuString[2] := ' Item 2';
SubmenuString[3] := ' Item 3';
end;
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Contents of Sub Menu # 2 *)
(* ------------------------------------------------------------------------- *)
new (SubMenu[2]); {creates variable on the heap}
with Submenu[2]^ do
begin
Num_Submenu_Entries := 3;
Submenu_Width := 8;
SubMenuChar[1] := 'A';
SubMenuChar[2] := 'B';
SubMenuChar[3] := 'Q';
SubMenuString[1] := ' Item 1';
SubMenuString[2] := ' Item 2';
SubmenuString[3] := 'uit';
end;
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Contents of Sub Menu # 3 *)
(* ------------------------------------------------------------------------- *)
new (SubMenu[3]); {creates variable on the heap}
with SubMenu[3]^ do
begin
Num_Submenu_Entries := 3;
Submenu_Width := 20;
SubMenuChar[1] := 'P';
SubMenuChar[2] := 'G';
SubMenuChar[3] := 'C';
SubMenuString[1] := 'lot a single file';
SubMenuString[2] := 'raph multiple files';
SubMenuString[3] := 'ompare two files';
end;
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Contents of Sub Menu # 4 *)
(* ------------------------------------------------------------------------- *)
new (SubMenu[4]); {creates variable on the heap}
with SubMenu[4]^ do
begin
Num_Submenu_Entries := 2;
Submenu_Width := 16;
SubMenuChar[1] := 'E';
SubMenuChar[2] := 'P';
SubMenuString[1] := 'dit Portfolio';
SubMenuString[2] := 'ortfolio Report';
end;
(* ------------------------------------------------------------------------- *)
end; { end of submenu init }
(* ------------------------------------------------------------------------ *)
(* Pop Up Menu Declarations *)
(* ------------------------------------------------------------------------ *)
Procedure Menu_Init1;
begin
new (Menu_Items[1]); {creates variable on the heap}
With Menu_Items[1]^ do
begin
MenuEntriesFirst[1] := '1'; { highlighted first char or num }
MenuEntriesString[1] := ' Menu Item 1'; { rest of string }
MenuEntriesFirst[2] := '2';
MenuEntriesString[2] := ' Menu Item 2';
MenuEntriesFirst[3] := '3';
MenuEntriesString[3] := ' Menu Item 3';
MenuEntriesFirst[4] := '4';
MenuEntriesString[4] := ' Menu Item 4';
MenuEntriesFirst[5] := '5';
MenuEntriesString[5] := ' Menu Item 5';
end;
end;
Procedure Menu_Init2;
Begin
new (Menu_Items[2]); {creates variable on the heap}
With Menu_Items[2]^ do
begin
MenuEntriesFirst[1] := '1'; { highlighted first char or num }
MenuEntriesString[1] := ' Menu Item 1'; { rest of string }
MenuEntriesFirst[2] := '2';
MenuEntriesString[2] := ' Menu Item 2';
MenuEntriesFirst[3] := '3';
MenuEntriesString[3] := ' Return to Pulldown Menu';
end;
end;
Procedure Menu_Init3;
Begin
new (Menu_Items[3]); {creates variable on the heap}
With Menu_Items[3]^ do
begin
MenuEntriesFirst[1] := '1'; { highlighted first char or num }
MenuEntriesString[1] := ' Menu Item 1'; { rest of string }
MenuEntriesFirst[2] := '2';
MenuEntriesString[2] := ' Menu Item 2';
MenuEntriesFirst[3] := '3';
MenuEntriesString[3] := ' Menu Item 3';
MenuEntriesFirst[4] := '4';
MenuEntriesString[4] := ' Menu Item 4';
MenuEntriesFirst[5] := '5';
MenuEntriesString[5] := ' Menu Item 5';
MenuEntriesFirst[6] := '6';
MenuEntriesString[6] := ' Menu Item 6';
MenuEntriesFirst[7] := '7';
MenuEntriesString[7] := ' Menu Item 7';
end;
end;
Procedure Menu_Init4;
Begin
new (Menu_Items[4]); {creates variable on the heap}
With Menu_Items[4]^ do
begin
MenuEntriesFirst[1] := '1'; { highlighted first char or num }
MenuEntriesString[1] := ' Menu Item 1'; { rest of string }
MenuEntriesFirst[2] := '2';
MenuEntriesString[2] := ' Menu Item 2';
MenuEntriesFirst[3] := '3';
MenuEntriesString[3] := ' Menu Item 3';
MenuEntriesFirst[4] := '4';
MenuEntriesString[4] := ' Menu Item 4';
MenuEntriesFirst[5] := '5';
MenuEntriesString[5] := ' Menu Item 5';
end;
end;
Procedure Menu_Init5;
Begin
new (Menu_Items[5]); {creates variable on the heap}
With Menu_Items[5]^ do
begin
MenuEntriesFirst[1] := 'A'; { highlighted first char or num }
MenuEntriesString[1] := ' Menu Item 1'; { rest of string }
MenuEntriesFirst[2] := 'B';
MenuEntriesString[2] := ' Menu Item 2';
MenuEntriesFirst[3] := 'C';
MenuEntriesString[3] := ' Menu Item 3';
MenuEntriesFirst[4] := 'D';
MenuEntriesString[4] := ' Menu Item 4';
MenuEntriesFirst[5] := 'E';
MenuEntriesString[5] := ' Menu Item 5';
end;
end;
(* ------------------------------------------------------------------------ *)
(* End of Pop Up Menu Declarations *)
(* ------------------------------------------------------------------------ *)
(* ------------------------------------------------------------------------ *)
(* Start of Main Program *)
(* ------------------------------------------------------------------------ *)
BEGIN
Cursor_Off;
MainMenu_Init;
Submenu_Init;
DrawMainHeader;
repeat
ch := readkey;
if ch <> #0 then HandleKeyMain (ch)
else HandleFuncKeyMain (ReadKey);
If Selection_Made = True then
begin
Show_Sub := False;
Selection_Made := False;
textcolor (7); textbackground (0);
(* ------------------------------------------------------------------------ *)
(* Your Code Goes Here *)
(* ------------------------------------------------------------------------ *)
(* ------------------------------------------------------------------------ *)
(* The Pulldown Menu System will return three values: *)
(* *)
(* Pulldown_Menu_Number - The Selected Pulldown Menu header *)
(* Pulldown_Menu_Selection - The item number selected in the submenu *)
(* PopUp_Menu_Selection - The PopUp menu item number if a menu was *)
(* displayed *)
(* *)
(* Each of these values can be used in a case statement to trigger some *)
(* action or call to one of your routines. *)
(* ------------------------------------------------------------------------ *)
Case Pulldown_Menu_Number of
1: Case Pulldown_Menu_Selection of
1 : begin
Menu_Init1;
MakeMenu (33, 12, 13, 5, Menu_Items[1]);
gotoxy (15,15);
writeln ('Here''s your first screen.');
gotoxy (15,16);
writeln ('This will now be saved in memory to demonstrate the');
gotoxy (15,17);
writeln ('Save & Restore Screen Procedures.');
gotoxy (30,20);
writeln ('Hit the Return key to continue.');
repeat
ch := readKey;
until ch = #13;
Save_Screen;
clrscr;
gotoxy (5,5);
write ('You selected Pulldown Menu Number ',
Pulldown_Menu_Number,
', Sub Menu Number ',
Pulldown_Menu_Selection);
GotoXY (5,7);
WriteLn ('You selected PopUp Menu Entry ',
PopUp_Menu_Selection);
GotoXY (5,10);
writeln ('With this information and a CASE statement you can now run your application.');
gotoXY (5,14);
WriteLn ('Hit the Return key to go back to the Pulldown menu & restore the');
gotoxy (5,15);
writeln ('previous screen.');
repeat
ch := readKey;
until ch = #13;
Restore_Screen;
repeat
ch := readKey;
until ch = #13;
gotoxy(1,14); ClrEol;
gotoxy(1,15); ClrEol;
gotoxy(1,16); ClrEol;
gotoxy(1,17); ClrEol;
gotoxy(1,18); ClrEol;
gotoxy(1,20); ClrEol;
end;
2 : begin
Done_PopUp_Menu := false;
Menu2: Menu_Init2;
MakeMenu (33, 12, 25, 3, Menu_Items[2]);
If PopUp_Menu_Selection = 3 then
Done_PopUp_Menu := True;
If (not Done_PopUp_Menu) Then
begin
Save_Screen;
ClrScr;
gotoxy (5,10);
write ('You selected Pulldown Menu ', Pulldown_Menu_Number,
', Sub Menu Number ', Pulldown_Menu_Selection);
GotoXY (5,12);
WriteLn ('You selected PopUp Menu Number ',
PopUp_Menu_Selection);
gotoxy (5,15); writeln ('Hit the return key to continue');
repeat ch := readkey; until ch = #13;
Restore_Screen;
Goto Menu2;
end;
end;
3 : begin
gotoxy (5,7);
write ('You selected Pulldown Menu Number ',
Pulldown_Menu_Number,
', Sub Menu Number ',
Pulldown_Menu_Selection);
GotoXY (5,10);
writeln ('With this information and a CASE statement you can now run your application.');
gotoXY (5,14);
WriteLn ('Hit the Return to continue ...');
repeat
ch := readkey;
until ch = #13;
gotoxy (1,7); ClrEol;
gotoxy (1,10); ClrEol;
gotoxy (1,14); ClrEol;
end;
end; { end of case for submenu #1 }
2: Case Pulldown_Menu_Selection of
1 : begin
Menu_Init4;
MakeMenu (33, 12, 13, 5, Menu_Items[4]);
gotoxy (5,7);
write ('You selected Pulldown Menu ',
Pulldown_Menu_Number,
', Sub Menu Number ', Pulldown_Menu_Selection);
GotoXY (5,10);
WriteLn ('You selected PopUp Menu Number ',
PopUp_Menu_Selection);
GotoXY (5,13);
writeln ('With this information and a CASE statement you can now run your application.');
gotoXY (5,15);
WriteLn ('Hit the Return to continue ...');
repeat
ch := readkey;
until ch = #13;
gotoxy (1,7); ClrEol;
gotoxy (1,10); ClrEol;
gotoxy (1,13); ClrEol;
gotoxy (1,15); ClrEol;
end;
2 : begin
Menu_Init5;
MakeMenu (33, 12, 13, 5, Menu_Items[5]);
gotoxy (5,7);
write ('You selected Pulldown Menu ',
Pulldown_Menu_Number,
', Sub Menu Number ', Pulldown_Menu_Selection);
GotoXY (5,10);
WriteLn ('You selected PopUp Menu Number ',
PopUp_Menu_Selection);
GotoXY (5,13);
writeln ('With this information and a CASE statement you can now run your application.');
gotoXY (5,15);
WriteLn ('Hit the Return to continue ...');
repeat
ch := readkey;
until ch = #13;
gotoxy (1,7); ClrEol;
gotoxy (1,10); ClrEol;
gotoxy (1,13); ClrEol;
gotoxy (1,15); ClrEol;
end;
3 : begin
Done := True; { Quit }
end;
end; { end of case for submenu #2 }
3: Case Pulldown_Menu_Selection of
1 : begin
gotoxy (5,7);
write ('You selected Pulldown Menu Number ',
Pulldown_Menu_Number,
', Sub Menu Number ',
Pulldown_Menu_Selection);
GotoXY (5,10);
writeln ('With this information and a CASE statement you can now run your application.');
gotoXY (5,14);
WriteLn ('Hit the Return to continue ...');
repeat
ch := readkey;
until ch = #13;
gotoxy (1,7); ClrEol;
gotoxy (1,10); ClrEol;
gotoxy (1,14); ClrEol;
end;
2 : begin
gotoxy (5,7);
write ('You selected Pulldown Menu Number ',
Pulldown_Menu_Number,
', Sub Menu Number ',
Pulldown_Menu_Selection);
GotoXY (5,10);
writeln ('With this information and a CASE statement you can now run your application.');
gotoXY (5,14);
WriteLn ('Hit the Return to continue ...');
repeat
ch := readkey;
until ch = #13;
gotoxy (1,7); ClrEol;
gotoxy (1,10); ClrEol;
gotoxy (1,14); ClrEol;
end;
3 : begin
gotoxy (5,7);
write ('You selected Pulldown Menu Number ',
Pulldown_Menu_Number,
', Sub Menu Number ',
Pulldown_Menu_Selection);
GotoXY (5,10);
writeln ('With this information and a CASE statement you can now run your application.');
gotoXY (5,14);
WriteLn ('Hit the Return to continue ...');
repeat
ch := readkey;
until ch = #13;
gotoxy (1,7); ClrEol;
gotoxy (1,10); ClrEol;
gotoxy (1,14); ClrEol;
end;
end; { end of case for submenu #3 }
4: Case Pulldown_Menu_Selection of
1 : begin
gotoxy (5,7);
write ('You selected Pulldown Menu Number ',
Pulldown_Menu_Number,
', Sub Menu Number ',
Pulldown_Menu_Selection);
GotoXY (5,10);
writeln ('With this information and a CASE statement you can now run your application.');
gotoXY (5,14);
WriteLn ('Hit the Return to continue ...');
repeat
ch := readkey;
until ch = #13;
gotoxy (1,7); ClrEol;
gotoxy (1,10); ClrEol;
gotoxy (1,14); ClrEol;
end;
2 : begin
gotoxy (5,7);
write ('You selected Pulldown Menu Number ',
Pulldown_Menu_Number,
', Sub Menu Number ',
Pulldown_Menu_Selection);
GotoXY (5,10);
writeln ('With this information and a CASE statement you can now run your application.');
gotoXY (5,14);
WriteLn ('Hit the Return to continue ...');
repeat
ch := readkey;
until ch = #13;
gotoxy (1,7); ClrEol;
gotoxy (1,10); ClrEol;
gotoxy (1,14); ClrEol;
end;
end; { end of case for submenu #4 }
end; { end of case for Pulldown_Menu_Number }
(* ------------------------------------------------------------------------- *)
(* Your code ends here *)
(* ------------------------------------------------------------------------- *)
selection_made := false;
end; { end of If Selection_Made loop }
until Done = True;
Cursor_On;
ClrScr;
end.